# Usage: map2eye.tcl [-?] [--] variant.map game.txt [title]

package require Iexpect
package require MapExpect

namespace eval Map2Eye {

	proc mention {error {info {}}} {
		puts "Error: $error"
		if {[llength $info]} {
			puts [join $info "\n"]
		}
		return 0
	}
	
	proc fileCheck {fileName fileExt hasToExist} {
		if {![string equal -nocase ".$fileExt" [file extension $fileName]]} {
			mention "Expected file extension $fileExt for file: $fileName"
			return 0
		}
		if {$hasToExist && ![file exists $fileName]} {
			mention "File does not exist: $fileName"
			return 0
		}
		return 1
	}
	
	proc purge {listVar el args} {
		upvar $listVar list
		set found [lsearch $list $el]
		if {$found >= 0} {
			set list [eval [list lreplace $list $found $found] $args]
		}
		return $found
	}
	
	proc move {arrVar from to} {
		upvar $arrVar arr
		if {[info exists arr($from)]} {
			set arr($to) $arr($from)
			unset arr($from)
		}
	}
	
	proc map2eye {variantMapFile gameFile {title {}}} {

		if {![fileCheck $variantMapFile map 1]} return
		if {![fileCheck $gameFile txt 0]} return
		
		# Piece identifications
		set rePower "\\w\[-.+_\\w\]+"
		set reTerritory "\\w{3}"
		set reHome "\[~@\]*${reTerritory}|&sc"
		set reCoast "/\\w{2}"
		set reUnit "\[a-z\]"
		
		# Info storage
		set power ""
		set powers {}
		array set homes ""
		array set supplies ""
		array set units ""
		set neutrals {}
		
		# Parsing
		MapExpect I -file $variantMapFile -white -nocase
		
		I expect line "^$" {
			I continue
		} "^#" {
			I continue
		} "^begin (\\S)(\\S*) (-?\\d+) \\w+$" {
			set gameStart "[I get match 3] [string toupper [I get match 1]][string tolower [I get match 2]]"
			I continue
		} "^(unowned|neutral|centers)(( -?$reTerritory)*)$" {
			foreach supply [string toupper [I get match 2]] {
				if {[regexp "^-" $supply]} {
					purge neutrals [string range $supply 1 end]
				} else {
					if {[lsearch $neutrals $supply] >= 0} continue
					foreach player [array names supplies] {
						if {[purge supplies($player) $supply] >= 0} break
					}
					lappend neutrals $supply
				}
			}
			I continue
		} "^(inhabits|home|homes)(( $reHome)*)$" {
			set homes($power) [string toupper [regsub -all "\[~@\]" [I get match 2] ""]]
			I continue
		} "^owns(( $reTerritory)*)$" {
			set supplies($power) [string toupper [I get match 1]]
			foreach supply $supplies($power) {
				if {[purge neutrals $supply] >= 0} continue
				foreach player [array names supplies] {
					if {[string equal $player $power]} continue
					if {[purge supplies($player) $supply] >= 0} break
				}
			}
			I continue
		} "^units$" {
			unset units($power)
			unset locations($power)
			I continue
		} "^unplayed(( $rePower)*)$" {
			foreach player [string toupper [regsub -all "^_|\\+" [I get match 1] ""]] {
				purge powers $player
				unset units($player)
				unset locations($player)
				if {[info exists supplies($player)]} {
					unset supplies($player)
					unset homes($player)
				}
			}
			I continue
		} "^drop(( ($reTerritory)($reCoast)?)*)$" {
			foreach position [string toupper [I get match 1]] {
				regexp "^$reTerritory" $position location
				if {[string equal $location $position]} {
					foreach player [array names supplies] {
						purge supplies($player) $location
					}
					foreach player [array names homes] {
						purge homes($player) $location
					}
					foreach player [array names locations] {
						if {[set found [purge locations($player) $location]] >= 0} {
							set units($player) [lreplace $units($player) $found $found]
						}
					}
					purge neutrals $location
				} else {
					foreach player [array names locations] {
						set found [lsearch $locations($player) $location]
						if {$found >= 0} {
							set unit [lindex $units($player) $found]
							if {[string equal $position [lindex $unit 1]]} {
								set units($player) [lreplace $units($player) $found $found "[lindex $unit 0] $location"]
							}
							break
						}
					}
				}
			}
			I continue
		} "^(\\w+ )?directives$" {
			I expect line "^end directives$" {
			} default {
				I continue
			}
			I continue
		} "^dummy|militia|reserves$" {
			I continue
		} "^(player|dummy|victory|flow|league|rule|coast|land|water|shut|port|amend|notify|flags|shroud) " {
			I continue
		} "^control ($rePower)$" {
			switch [llength $power] 0 {
				mention "Power not defined yet before \"[I get output]\""
			} 1 {
				lappend power [string toupper [regsub -all "\[+.\]" [I get match 1] ""]]
			} default {
				set power [lreplace $power 1 1 [string toupper [regsub -all "\[+.\]" [I get match 1] ""]]]
			}
			if {[lsearch $powers $power] == -1} {
				lappend powers $power
			}
			I continue
		} "^($reTerritory) ?->\[^=\]+= ?($reTerritory)" {
			set oldLocation [string toupper [I get match 1]]
			set newLocation [string toupper [I get match 2]]
			foreach player [array names locations] {
				if {[set found [purge locations($player) $oldLocation $newLocation]] >= 0} {
					set units($player) [lreplace $units($player) $found $found [regsub -nocase "($reUnit) ($reTerritory)($reCoast)?" [lindex $units($player) $found] "\\1 $newLocation\\3"]]
					break
				}
			}
			foreach player [array names homes] {
				purge homes($player) $oldLocation $newLocation
			}
			foreach player [array names supplies] {
				purge supplies($player) $oldLocation $newLocation
			}
			purge neutrals $oldLocation $newLocation
			I continue
		} "^($reTerritory)($reCoast) ?->\[^=\]+= ?($reTerritory)($reCoast)" {
			set oldLocation [string toupper [I get match 1]]
			set oldCoast [string toupper [I get match 2]]
			set newLocation [string toupper [I get match 3]]
			set newCoast [string toupper [I get match 4]]
			foreach player [array names locations] {
				# We assume that the non-coast renaming took place first, so all player data already uses the new location.
				# In this case we only need to replace the coast.
				if {[set found [lsearch $locations($player) $newLocation]] >= 0} {
					set unit [lindex $units($player) $found]
					if {[regexp -nocase "($reUnit) ($reTerritory)($reCoast)" $unit dummy unitType unitLocation unitCoast]} {
						if {[string equal -nocase $oldCoast $unitCoast]} {
							set units($player) [lreplace $units($player) $found $found "$unitType $newLocation$newCoast"]
						}
					}
					break
				}
			}
			I continue
		} "^\[^=\]+= ?($reTerritory)($reCoast)?" {
			I continue
		} "^$reUnit ($reTerritory)($reCoast)?$" {
			set location [string toupper [I get match 1]]
			set unit [string toupper [I get match]]
			if {![info exists locations($power)]} {
				foreach player [array names locations] {
					if {[set found [purge locations($player) $location]] >= 0} {
						set units($player) [lreplace $units($player) $found $found]
						break
					}
				}
				set units($power) [list $unit]
				set locations($power) [list $location]
			} else {
				if {[set found [lsearch $locations($power) $location]] >= 0} {
					set units($power) [lreplace $units($power) $found $found [string toupper [I get match]]]
				} else {
					foreach player [array names locations] {
						if {[string equal $player $power]} continue
						if {[set found [purge locations($player) $location]] >= 0} {
							set units($player) [lreplace $units($player) $found $found]
							break
						}
					}
					lappend units($power) $unit
					lappend locations($power) $location
				}
			}
			I continue
		} "^($rePower)( ?-> ?($rePower))?( \\(($rePower)?(:.)?\\))?(( \[-+*\]?($reHome))*)$" {
			set power [string toupper [regsub -all "\[+.\]" [I get match 1] ""]]
			set next 1
			if {[string length [I get match 2]]} {
				set newPower [string toupper [regsub -all "\[+.\]" [I get match 3] ""]]
				if {[set found [lsearch $powers $power]] == -1} {
					mention "Replaced power <$power> not yet defined"
					set power $newPower
				} elseif {[lsearch $powers $newPower] != -1} {
					set next 2
				} else {
					set next 2
					set powers [lreplace $powers $found $found $newPower]
					move supplies $power $newPower
					move homes $power $newPower
					move units $power $newPower
					move locations $power $newPower
				}
			}
			if {$next == 1} {
				set next 2
				if {[lsearch $powers $power] == -1} {
					lappend powers $power
				}
			}
			if {$next == 2} {
				if {![info exists supplies($power)]} {
					set addToSupplies 1
				} elseif {![info exists homes($power)]} {
					set addToSupplies 0
				} else {
					set addToSupplies [expr [string equal $homes($power) $supplies($power)]]
				}
				foreach supply [string toupper [regsub -all "\[~@\]" [I get match 7] ""]] {
					switch -- [string index $supply 0] "+" {
					} "*" {
					} "-" {
						if {[string equal -nocase "&sc" $supply]} {continue}
						set supply [string range $supply 1 end]
						purge homes($power) $supply
						if $addToSupplies {
							if {[purge supplies($power) $supply] >= 0} {
								lappend neutrals $supply
							}
						}
					} default {
						if {[string equal -nocase "&sc" $supply]} {continue}
						if {$addToSupplies} {
							lappend supplies($power) $supply
							if {[purge neutrals $supply] >= 0} continue
							foreach player [array names supplies] {
								if {[string equal $player $power]} continue
								if {[purge supplies($player) $supply] >= 0} break
							}
						}
						lappend homes($power) $supply
						purge neutrals $supply
					}
				}
			}
			I continue
		} default {
			mention "Can't interpret \"[I get output]\""
			I continue
		}
		
		itcl::delete object I
		
		foreach power $powers {
			if {![info exists homes($power)]} {
				set homes($power) {}
			}
			if {![info exists supplies($power)]} {
				set supplies($power) {}
			}
			if {![info exists units($power)]} {
				set units($power) {}
			}	
		}
		
		# Output
		set g [open $gameFile w]
		
		if {![string length $title]} {
			set title [file rootname [lindex [file split $gameFile] end]]
		}
		
		# Directives
		puts $g "%# Title: $title"
		if [info exists gameStart] {
			puts $g "%# GameStart: $gameStart"
		}
		
		# Game start season
		puts $g "\n% Season"
		puts $g "\nGameStart"
		
		puts $g "\n% Centers"
		foreach power $powers {
			switch [llength $power] 2 { 
				puts $g "\n[lindex $power 1] V [lindex $power 0]\n"
			} default {
				puts $g "\n$power\n"
			}
			if [llength $supplies($power)] {
				foreach supply $supplies($power) {
					if {[lsearch $homes($power) $supply] == -1} {
						puts $g "$supply \$"
					} else {
						puts $g "$supply ^"
					}
				}
				foreach supply $homes($power) {
					if {[lsearch $supplies($power) $supply] == -1} {
						puts $g "$supply `"
					}
				}
			}
		}
		if [llength $neutrals] {
			puts $g "\nUNOWNED\n"
			foreach center $neutrals {
				puts $g "$center $"
			}
		}
		
		puts $g "\n% Orders"
		foreach power $powers {
			switch [llength $power] 2 { 
				puts $g "\n[lindex $power 1] V [lindex $power 0]\n"
			} default {
				puts $g "\n$power\n"
			}
			if [llength $units($power)] {
				foreach unit $units($power) {
					puts $g "$unit !"
				}
			}
		}
		
		puts $g "\n% End"
		puts $g "\nEnd"
		close $g
	}
	
}
	
# Check arguments.

if {[llength $argv]} {
	set helpInfo {
	 	"Usage: map2eye.tcl [-?] [--] variant.map game.txt [title]"
		"\t-?: Display this help message"
		"\t--: No more switches to follow"	
	}
	
	while {[llength $argv] && [regexp "^\[-/\](.)$" [lindex $argv 0] switching swi]} {
		set argv [lrange $argv 1 end]
		switch -- $swi ? {
			puts [join $helpInfo "\n"]
			exit
		} - {
			break
		} default {
			Map2Eye::mention "Switch <$swi> not supported." $helpInfo
			exit
		}
	}
	
	set arguments $argv
	set argv {}
	switch [llength $arguments] 2 {
		lappend arguments {}
	} 3 {
	} default {
		Map2Eye::mention [join {
		 	"Either 2 or 3 arguments needed, the name of a variant .map file and the name of a DPeye style game record .txt file."
			"1 optional argument, the game title (by default the first part of the .txt file)."
		} "\n"] $helpInfo
		exit
	}
	
	eval Map2Eye::map2eye $arguments
}
